home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0081_Moving landscape.pas < prev    next >
Pascal/Delphi Source File  |  1994-02-05  |  5KB  |  167 lines
  1.  
  2. { NEEDS A MOUSE !!!
  3. And here as promised to several fellows, the moving landscape!
  4. It needs a mouse, as you can see...
  5. Again nothing realy nifty (imho), no bankswitching, no mode-x, no virtual
  6. screens, no palette tricks, just some hard math! ;-) Have fun with it...
  7.  
  8. --- cut here ---}
  9.  
  10. program landscape_2d;
  11. { 2D landscape (without rotating). Made by Bas van Gaalen, Holland, PD }
  12. const
  13.   vseg = $a000;
  14.   a_density = 4;
  15.   roughness = 20;
  16.   maxx_scape = 320; maxy_scape = 200;
  17.   maxh = 128;
  18.   maxx = 250 div a_density; maxy = 110 div a_density;
  19. var landscape : array[0..maxx_scape*maxy_scape] of byte;
  20.  
  21. { mouse routines ------------------------------------------------------------}
  22.  
  23. function mouseinstalled : boolean; assembler; asm
  24.   xor ax,ax; int 33h; cmp ax,-1; je @skip; xor al,al; @skip: end;
  25.  
  26. function getmousex : word; assembler; asm
  27.   mov ax,3; int 33h; mov ax,cx end;
  28.  
  29. function getmousey : word; assembler; asm
  30.   mov ax,3; int 33h; mov ax,dx end;
  31.  
  32. function leftpressed : boolean; assembler; asm
  33.   mov ax,3; int 33h; and bx,1; mov ax,bx end;
  34.  
  35. procedure mousesensetivity(x,y : word); assembler; asm
  36.   mov ax,1ah; mov bx,x; mov cx,y; xor dx,dx; int 33h end;
  37.  
  38. procedure mousewindow(l,t,r,b : word); assembler; asm
  39.   mov ax,7; mov cx,l; mov dx,r; int 33h; mov ax,8
  40.   mov cx,t; mov dx,b; int 33h end;
  41.  
  42. { lowlevel video routines ---------------------------------------------------}
  43.  
  44. procedure setvideo(m : word); assembler; asm
  45.   mov ax,m; int 10h end;
  46.  
  47. procedure putpixel(x,y : word; c : byte); assembler; asm
  48.   mov ax,vseg; mov es,ax; mov ax,y; mov dx,320; mul dx
  49.   mov di,ax; add di,x; mov al,c; mov [es:di],al end;
  50.  
  51. function getpixel(x,y : word) : byte; assembler; asm
  52.   mov ax,vseg; mov es,ax; mov ax,y; mov dx,320; mul dx
  53.   mov di,ax; add di,x; mov al,[es:di] end;
  54.  
  55. procedure setpal(c,r,g,b : byte); assembler; asm
  56.   mov dx,03c8h; mov al,c; out dx,al; inc dx; mov al,r
  57.   out dx,al; mov al,g; out dx,al; mov al,b; out dx,al end;
  58.  
  59. procedure retrace; assembler; asm
  60.   mov dx,03dah; @l1: in al,dx; test al,8; jnz @l1
  61.   @l2: in al,dx; test al,8; jz @l2 end;
  62.  
  63. { initialize palette colors -------------------------------------------------}
  64.  
  65. procedure initcolors;
  66. var i : byte;
  67. begin
  68.   for i := 0 to 63 do begin
  69.     setpal(i+1,21+i div 3,21+i div 3,63-i);
  70.     setpal(i+65,42-i div 3,42+i div 3,i div 3);
  71.   end;
  72. end;
  73.  
  74. { landscape generating routines ---------------------------------------------}
  75.  
  76. procedure adjust(xa,ya,x,y,xb,yb : integer);
  77. var d,c : integer;
  78. begin
  79.   if getpixel(x,y) <> 0 then exit;
  80.   d := abs(xa-xb)+abs(ya-yb);
  81.   c := (50*(getpixel(xa,ya)+getpixel(xb,yb))+trunc((10*random-5)*d*roughness))
  82. div 100;
  83.   if c < 1 then c := 1;
  84.   if c >= maxh then c := maxh;
  85.   putpixel(x,y,c);
  86. end;
  87.  
  88. procedure subdivide(l,t,r,b : integer);
  89. var x,y : integer; c : integer;
  90. begin
  91.   if (r-l < 2) and (b-t < 2) then exit;
  92.   x := (l+r) div 2; y := (t+b) div 2;
  93.   adjust(l,t,X,t,r,t);
  94.   adjust(r,t,r,Y,r,b);
  95.   adjust(l,b,X,b,r,b);
  96.   adjust(l,t,l,Y,l,b);
  97.   if getpixel(x,y) = 0 then begin
  98.     c := (getpixel(l,t)+getpixel(r,t)+getpixel(r,b)+getpixel(l,b)) div 4;
  99.     putpixel(x,y,c);
  100.   end;
  101.   subdivide(l,t,x,y);
  102.   subdivide(x,t,r,y);
  103.   subdivide(l,y,x,b);
  104.   subdivide(x,y,r,b);
  105. end;
  106.  
  107. procedure generatelandscape;
  108. var image : file; vidram : byte absolute vseg:0000; i : word;
  109. begin
  110.   assign(image,'plasma.img');
  111.   {$I-} reset(image,1); {$I+}
  112.   if ioresult <> 0 then begin
  113.     randomize;
  114.     putpixel(0,0,random(maxh));
  115.     putpixel(maxx_scape-1,0,random(maxh));
  116.     putpixel(maxx_scape-1,maxy_scape-1,random(maxh));
  117.     putpixel(0,maxy_scape-1,random(maxh));
  118.     subdivide(0,0,maxx_scape,maxy_scape);
  119.     rewrite(image,1);
  120.     blockwrite(image,mem[vseg:0],maxx_scape*maxy_scape);
  121.   end else blockread(image,mem[vseg:0],maxx_scape*maxy_scape);
  122.   close(image);
  123.   move(vidram,landscape,sizeof(landscape));
  124.   fillchar(vidram,maxx_scape*maxy_scape,0);
  125.   for i := 0 to maxx_scape*maxy_scape-1 do landscape[i] := 110+Landscape[i] div
  126. 2;
  127. end;
  128.  
  129. { the actual displaying of the whole thing! ---------------------------------}
  130.  
  131. procedure displayscape;
  132. var i,j,previ,prevj,n : word; x : integer;
  133. begin
  134.   i := 0; j := 0;
  135.   repeat
  136.     {retrace;}
  137.     previ := i; i := getmousex; prevj := j; j := getmousey;
  138.     for n := 0 to maxx*maxy-1 do begin
  139.       x := -(a_density*(integer(n mod maxx)-(maxx shr 1)-1)*45) div (integer(n
  140. div maxx)-45)-90;
  141.       if (x >= -250) and (X <= 60) then begin
  142.         mem[vseg:320*(a_density*integer(n div maxx)-landscape[n mod
  143. maxx+previ+(n div maxx+prevj)*maxx_scape])+x] := 0;
  144.         mem[vseg:320*(a_density*integer(n div maxx)-landscape[n mod maxx+i+(n
  145. div maxx+j)*maxx_scape])+x] :=
  146.           landscape[(integer(n mod maxx)+i)+(integer(n div
  147. maxx)+j)*maxx_scape]-100;
  148.       end;
  149.     end;
  150.   until leftpressed;
  151. end;
  152.  
  153. { main routine --------------------------------------------------------------}
  154.  
  155. begin
  156.   if mouseinstalled then begin
  157.     setvideo($13);
  158.     initcolors;
  159.     generatelandscape;
  160.     mousewindow(0,0,maxx_scape-maxx,maxy_scape-maxy);
  161.     mousesensetivity(25,25);
  162.     displayscape;
  163.     setvideo(3);
  164.   end else writeln('This interactive thing realy needs a mouse...');
  165. end.
  166.  
  167.